# TODO: Add comment
# 
# Author: bastian
###############################################################################


tested.api.versions <- list(c("1","0","6"))

url <- "http://trac:kdn64fS2@192.168.56.101:8000/tracenv/login/xmlrpc"

tracUrl <- "trac.example.com:8000/tracenv/login/xmlrpc"
tracUser <- "username"
tracPasswd <- "password"

setUrl <- function()
{
  url <- paste("http://",tracUser,":",tracPasswd,"@",tracUrl,sep="")
  assignInNamespace("url", url, "TracR")
}

#' set URL of the trac server used by tracR
#' 
#' The URL should be specified without specifying the protocoll e.g. http://
#' @param url The url of the trac server.
#' @examples setTracUrl("trac.example.com:8000/tracenv/login/xmlrpc")
#' @export 
setTracUrl <- function(url)
{
  assignInNamespace("tracUrl", url, "TracR")
  setUrl()
}

#' set username of the trac account used by tracR
#' 
#' Note that the account must have the XML_RPC permission set.
#' @param user The user name of the trac account.
#' @export 
setTracUser <- function(user)
{
  assignInNamespace("tracUser", user, "TracR")
  setUrl()
}

#' set password of the trac account used by tracR
#' 
#' @param password The user password of the trac account.
#' @export 
setTracPasswd <- function(password)
{
  assignInNamespace("tracPasswd", password, "TracR")
  setUrl()
}


toAscii <-rawToChar

toXML <- function(x)
{
	xmlInternalTreeParse(rawToChar(x))
}

#' Lists all available XMLRPC methods offered by the Trac server.
#' 
#' @export 
system.listMethods <- function()
{
	x<- xml.rpc(url=url,method="system.listMethods",.convert=toXML)
	xpathSApply(x,"//data/value",xmlValue)
}

#' Get the API version from the Trac server.
#' 
#' @export 
system.getAPIVersion <- function()
{
	x<- xml.rpc(url=url,method="system.getAPIVersion",.convert=toXML)
	xpathSApply(x,"//data/value",xmlValue)
}

#' Get the manual for a XMLRPC method offerd by the Trac server.
#'
#' @param method The name of the method.
#' @export 
system.methodHelp <- function(method)
{
	help <-xml.rpc(url=url,method="system.methodHelp",.convert=toXML,.args=list(method))
	cat(xpathSApply(help,"//param/value/string",xmlValue))
}

#' Get the signature of a XMLRPC method offerd by the Trac server.
#'
#' @param method The name of the method.
#' @export 
system.methodSignature <- function(method)
{
	sig <- xml.rpc(url=url,method="system.methodSignature",.convert=toXML,.args=list(method))
	xpathSApply(sig,"//data/value/string",xmlValue)
}

print_all.signatures <- function()
{
	methods <- system.listMethods()
	for (meth in methods)
	{
		print(paste(meth,system.methodSignature(meth),sep=" "))
	}
}

# function for generating methods automatically 
generateMethod <- function(method)
{	
	theargs <- strsplit(system.methodSignature(method),",",fixed=TRUE)[[1]] # TODO handle function with multiple signatures
	# test for nonexistent methods
	returntype <- theargs[1]
	theargs <- theargs[-1] # drop return type from args list
	if (returntype == "array")
	{
		xpath <- paste("//param/value/array/data/value")
	}
	else
	{
		xpath <- paste("//param/value/",returntype,sep="")
	}
	
	thefunction <- function(rpcargs=list())
	{
		res <- xml.rpc(url=url,method=method,.convert=toXML,.args=rpcargs)
		return(xpathSApply(res, xpath, xmlValue))
	}
	
	eval(substitute(assign(theName,thefunction,globalenv()), list(theName=method)))
}

generateErrorHandler <- function()
{
  tracSubmitTraceback<- function()
  {
    theError <- capture.output(traceback(x=sys.calls()))
    browser()
    topLevelCall <- strsplit(x=theError[1], split=":", fixed=TRUE)[[1]][-1]
    title <- paste("Error in function ", topLevelCall)
    message <- paste("An error occured following a call to", topLevelCall,".")
    message <- paste(message, "This is a machine generated message.\n", sep="\n")
    message <- paste(message, "The following stack trace could be recovered:", sep="\n")
    traceText <- paste(theError[1:(length(theError) - 14)],collapse="\n" )
    message <- paste(message, traceText, sep="\n")
    message <- paste(message, "\nThe Error occured on the following platform:", sep="\n")
    sysinfo <- paste( capture.output(sessionInfo()),collapse="\n" )
    message <- paste(message, sysinfo, sep="\n")
    
    ticket.create(list(title,message))
  }
  assign("tracSubmitTraceback",tracSubmitTraceback,globalenv())
}


#' Create wrappers for all calls offerd by the Trac server.
#'
#' This will also generate a function named 'tracSubmitTraceback'
#' which can be used as an error handler to submit tracebacks of errors
#' as bug reports.
#' @export 
bootstrap <- function()
{
	print(paste("Connecting to trac server ",url))
	
	server.API.version <- system.getAPIVersion()
	print(paste("Server API version:",paste(server.API.version,collapse=".")))
	if( !any(sapply(tested.api.versions, function(x) { identical(x, server.API.version)})))
		warning("Server returned untested API version.")
	
	all.methods <- system.listMethods()
	for (method in all.methods)
	{
		namespace <- strsplit(method,".",fixed=TRUE)[[1]][1]
		if(namespace != "system")
		{
			print(paste("Generating method:",method))
			generateMethod(method)
		}
	}
  generateErrorHandler()
}

